home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / mpfeel.lha / MPFeel / Plurals / mp_gc.m < prev    next >
Text File  |  1992-06-03  |  18KB  |  613 lines
  1. /*
  2.  *    Plurals
  3.  *
  4.  *    Author:    S.C.Merrall
  5.  *
  6.  *    File:    mp_gc.m
  7.  *
  8.  *    Contents:    heap_alloc
  9.  *            mp_alloc
  10.  *            test
  11.  *            eq
  12.  *            copy
  13.  *            mp_gc
  14.  *            gc
  15.  *
  16.  *    Description:    Allocation and garbage collection of heap objects
  17.  *            works with the same memory as mp_mem_mgmt uses but
  18.  *            the garbage collection processes are different. 
  19.  *
  20.  *    Change History:
  21.  *
  22.  *    Date   Name Comment
  23.  *    -------- ---- -------
  24.  *    16:04:91 SCM  Created
  25.  *    22:04:91 SCM  Uses MasPar Plural Heap objects instead of offsets
  26.  *    15:05:91 SCM  heap_alloc takes space as multiple of 16-bits not 32
  27.  *    16:06:91 SCM  mp_alloc transferred from mp_alloc.m
  28.  *    04:06:91 SCM  Sizes in bytes, plus alignment
  29.  *    26:01:92 SCM  Added some GC code
  30.  *    02:02:92 SCM  Made eq work properly and cope with symbols
  31.  *    06:04:92 SCM  Clever hack for nullp in test wont work as NIL changed
  32.  *
  33.  */
  34.  
  35. #include <mpl.h>
  36. #include <stdio.h>
  37.  
  38. #include "proc_pair.h"
  39.  
  40. #include "constant.h"
  41.  
  42. #include "mp_utils.h"
  43. #include "mp_object.h"
  44. #include "mp_debug_off.h"
  45. #include "mp_mem_mgmt.h"
  46. #include "mp_type.h"
  47. #include "mp_gc.h"
  48.  
  49. #define SDEBUG(x) DO_DEBUG(x)
  50.  
  51. char *gc_message;   /* Used to indicate what function caused the GC */
  52.  
  53. plural natural *gc_roots[MAX_GC_ROOTS+1];
  54. int next_gc_root = 0;
  55.  
  56. /* Scratch Space: same ammount of memory on each processor, used for message
  57.  *               passing and printing */
  58.  
  59. char            acu_scratch[SCRATCH_MEMORY_SIZE];
  60. visible plural char scratch[SCRATCH_MEMORY_SIZE];
  61.  
  62. /*  This array contains the size of a given object under its identifier */
  63.  
  64. #define TYPE_SIZE 0
  65. #define TYPE_ALIGN 1
  66.  
  67. int type_info_table[NUMBER_OF_TYPES][2] = { NULL,           NULL,
  68.                         INTEGER_SIZE,      INTEGER_ALIGN,
  69.                         MP_CONS_SIZE,      MP_CONS_ALIGN,
  70.                         MP_VECTOR_SIZE,    MP_VECTOR_ALIGN,
  71.                         MP_FLOAT_SIZE,     MP_FLOAT_ALIGN,
  72.                         MP_SYMBOL_SIZE,    MP_SYMBOL_ALIGN};
  73. /*
  74.  *     Each processors heap space can be grabage collected by mark and sweep
  75.  *  the marking is done by tracing through the heap space from the pointers
  76.  *  in the plural space. Garbage collection will be fired when heap_alloc 
  77.  *  fails, if GC fails to claim sufficient space, a global garbage collection
  78.  *  can be forced and another local garbage collection attempted. If that fails
  79.  *  to a reorganisation of the array may be able to make space available
  80.  */
  81.  
  82. /*----------------------------------------------------------------------------*
  83.  * Function   : heap_alloc
  84.  *
  85.  * Parameters : plural int space:        How much memory we want 
  86.  *                        allocated on each active
  87.  *                        processor. (in bytes)
  88.  *              plural int type:                the types of the things
  89.  *                                              were allocating space for
  90.  *        MP_PluralHeap MPPH_var:        MP_PluralHeap object, handle
  91.  *                        the plural heap objects.
  92.  *
  93.  * Description:    Allocates the requested ammount of memory on each active
  94.  *        processor. If one processor fails the whole operation fails.
  95.  *              The allocated space is aligned if appropriate, this may
  96.  *              cause gaps in the heap, these are filled with null objects
  97.  *              of the appropriate size.
  98.  *
  99.  * Result     : int:    SUCCESS/FAIL
  100.  *---------------------------------------------------------------------------*/
  101.  
  102. #ifdef __STDC__ 
  103.  
  104. int heap_alloc( plural int space, plural int type, MP_PluralHeap MPPH_var )
  105.  
  106. #else
  107.  
  108. int heap_alloc( space, type, MPPH_var )
  109.  
  110. plural int space;
  111. plural int type;
  112. MP_PluralHeap MPPH_var;
  113.  
  114. #endif
  115.  
  116. {
  117.   plural heap_header header;
  118.   plural int new_heap_space;
  119.   plural int align;
  120. DBG_CALL("heap_alloc");
  121. DBG_ARGS(fprintf(dbg,"space=????, type=????, MPPH_var=%04x: to_offsets=%04x",MPPH_var,OA_to_offsets(MPPH_var)));
  122.  
  123.   align = type_info_table[type][TYPE_ALIGN];
  124.  
  125.   new_heap_space = heap_space + 1;
  126.   new_heap_space = new_heap_space + 
  127.     (((new_heap_space * sizeof(natural)) % align) / sizeof(natural));
  128.  
  129.   /* new_heap_space is the location where the aligned data will begin */
  130.   /* the header will be placed in the previous location,              */
  131.  
  132.   if (globalor((plural_space - heap2plural(new_heap_space)) <=
  133.            heap2plural(byte2heap(space)+2))) {
  134.  
  135.     fprintf(stderr,"mp_alloc:No Space, trying back end GC\n");
  136.     mp_gc();
  137.     new_heap_space = heap_space + 1;
  138.     new_heap_space = new_heap_space +
  139.       (((new_heap_space * sizeof(natural)) % align) / sizeof(natural));
  140.  
  141.     if (globalor((plural_space - heap2plural(new_heap_space)) <=
  142.          heap2plural(byte2heap(space)))) {
  143.  
  144. DBG_FAIL(fprintf(dbg,"FAIL:No Space; p_space=%d, ",plural_space);DBG_PARG("h_space","%04d ",heap_space));
  145.       return  FAIL;
  146.     }
  147.   }
  148.   
  149.   /* Initialise header data, store heap offsets for caller,update heap space */
  150.  
  151.   *MPPH_var = new_heap_space-1;
  152.  
  153.   HH_set_space(heap_memory[*MPPH_var],space);
  154.   HH_set_free(heap_memory[*MPPH_var],0);
  155.   HH_set_info(heap_memory[*MPPH_var],type);
  156.   heap_space = new_heap_space + MP_LENGTH(OA_space(MPPH_var));
  157.  
  158. DBG_EXIT(fprintf(dbg,"SUCCESS"));
  159.   return SUCCESS;
  160. }
  161.  
  162. /*----------------------------------------------------------------------------*
  163.  * Function   : mp_alloc
  164.  *
  165.  * Parameters : plural int type:    The types of the objects to be
  166.  *                    allocated.
  167.  *        plural int quantity:    This is for giving vector size.
  168.  *        MP_PluralHeap MPPH_object:    MP_PluralHeap object, handle
  169.  *                    on the allocated plural heap space.
  170.  *
  171.  * Description:    Allocates different types and sizes of objects in 
  172.  *        parallel and initialises them all to nil.
  173.  *
  174.  * Result     : int:    FAIL/SUCCESS
  175.  *---------------------------------------------------------------------------*/
  176.  
  177. #ifdef __STDC__
  178.  
  179. int mp_alloc( plural int type, plural int quantity, MP_PluralHeap MPPH_object )
  180.  
  181. #else
  182.  
  183. int mp_alloc( type, quantity, MPPH_object )
  184.  
  185. plural int type;
  186. plural int quantity;
  187. MP_PluralHeap MPPH_object;
  188.  
  189. #endif
  190.  
  191. {
  192.   plural int size;
  193.   plural natural *plural space;
  194.   plural int i;
  195. DBG_CALL("mp_alloc");
  196. DBG_ARGS(fprintf(dbg,"type=????,quantity=????,MPPH_object=%04x",MPPH_object));
  197.  
  198.   /* Find sizes of objects being requested                       */
  199.   /* NOTE: this should be done via a table to reduce code length */
  200.  
  201.   if (globalor((type <= 0) || (type >= NUMBER_OF_TYPES))) {
  202.  
  203. DBG_FAIL(fprintf(dbg,"FAIL: Unknown types"));
  204.     return FAIL;
  205.   }
  206.  
  207.   size = type_info_table[type][TYPE_SIZE];
  208.  
  209.   /* Allocate space for new objects  */
  210.  
  211.   if (heap_alloc((quantity * size), type, MPPH_object) == FAIL) {
  212.  
  213. DBG_FAIL(fprintf(dbg,"FAIL: Unable to allocate space"));
  214.     return FAIL;
  215.   }
  216.  
  217. DBG_EXIT(fprintf(dbg,"SUCCESS"));
  218.   return SUCCESS;
  219. }
  220.  
  221. /*----------------------------------------------------------------------------*
  222.  * Function   : test
  223.  *
  224.  * Parameters : MP_PluralHeap MPPH_arg1:    Heap objects to test types of
  225.  *        plural int type:        Types we are expecting
  226.  *        MP_PluralHeap MPPH_result:    Boolean result
  227.  *
  228.  * Description:    Returns booleans indicating wether the objects are of the
  229.  *        type indicated by type.
  230.  *
  231.  * Result     : int FAIL/SUCCESS
  232.  *---------------------------------------------------------------------------*/
  233.  
  234. #ifdef __STDC__
  235.  
  236. int test( MP_PluralHeap MPPH_arg1, plural int type, MP_PluralHeap MPPH_result )
  237.  
  238. #else
  239.  
  240. int test( MPPH_arg1, type, MPPH_result )
  241.  
  242. MP_PluralHeap MPPH_arg1;
  243. plural int type;
  244. MP_PluralHeap MPPH_result;
  245.  
  246. #endif
  247.  
  248. {
  249.   plural int boolean;
  250. DBG_CALL("test");
  251. DBG_ARGS(fprintf(dbg,"MPPH_arg1=????, type=????, MPPH_result=????"));
  252.  
  253. /*   if (OA_offsets(MPPH_arg1) == NIL) {
  254.  *
  255.  *     boolean = (NIL == type);
  256.  *   }
  257.  *   else {
  258.  *  Can't tell if it's null by looking at the type and addresss since the
  259.  *  values overlap now
  260.  */
  261.  
  262.   boolean = OA_info(MPPH_arg1) == type;
  263.   
  264.   if (boolean) OA_offsets(MPPH_result) = NOT_NIL;
  265.   else OA_offsets(MPPH_result) = NIL;
  266.  
  267. DBG_EXIT(fprintf(dbg,"SUCCESS"));
  268.   return SUCCESS;
  269. }
  270.   
  271. /*----------------------------------------------------------------------------*
  272.  * Function   : eq
  273.  *
  274.  * Parameters : MP_PluralHeap MPPH_arg1:    Handle on plural space of
  275.  *        MP_PluralHeap MPPH_arg2:    objects to be compared
  276.  *        MP_PluralHeap MPPH_result:    Plural space containing
  277.  *                        resulting boolean values.
  278.  *
  279.  * Description: Compares the objects on the same processors and creates
  280.  *        a boolean result. 
  281.  *        Integers and floats are equal if their values are the same
  282.  *        otherwise if the addresses are equal the objects are equal -
  283.  *        This will need extending when symbols and doubles are added.
  284.  *
  285.  * Result     : int:    FAIL/SUCCESS
  286.  *---------------------------------------------------------------------------*/
  287.  
  288. #ifdef __STDC__
  289.  
  290. int eq( MP_PluralHeap MPPH_arg1, MP_PluralHeap MPPH_arg2, 
  291.     MP_PluralHeap MPPH_result )
  292.  
  293. #else
  294.  
  295. int eq( MPPH_arg1, MPPH_arg2, MPPH_result )
  296.  
  297. MP_PluralHeap MPPH_arg1;
  298. MP_PluralHeap MPPH_arg2;
  299. MP_PluralHeap MPPH_result;
  300.  
  301. #endif
  302.  
  303. {
  304.   plural int *plural result;
  305. DBG_CALL("eq");
  306. DBG_ARGS(fprintf(dbg,"MPPH_arg1=????, MPPH_arg2=????, MPPH_arg3=????"));
  307.  
  308.   OA_offsets(MPPH_result) = NIL;
  309.  
  310.   if (OA_offsets(MPPH_arg1) == OA_offsets(MPPH_arg2)) {
  311.  
  312.     OA_offsets(MPPH_result) = NOT_NIL;
  313.   }
  314.   
  315.   else if ((OA_offsets(MPPH_arg1)==NIL)||(OA_offsets(MPPH_arg1)==NOT_NIL) ||
  316.        (OA_offsets(MPPH_arg2)==NIL)||(OA_offsets(MPPH_arg2)==NOT_NIL)) {
  317.  
  318.     OA_offsets(MPPH_result) = NIL;
  319.   }
  320.   else if (OA_info(MPPH_arg1) != OA_info(MPPH_arg2)) {
  321.  
  322.     OA_offsets(MPPH_result) = NIL;
  323.   }
  324.   else if ((OA_info(MPPH_arg1) == INTEGER) ||
  325.        (OA_info(MPPH_arg1) == MP_SYMBOL)) {
  326.  
  327.     /* Just compare the bit patterns in affect */
  328.       
  329.     if ((*(plural int *plural) OA_data(MPPH_arg1)) ==
  330.     (*(plural int *plural) OA_data(MPPH_arg2))) 
  331.       OA_offsets(MPPH_result) = NOT_NIL;
  332.   }
  333.  
  334. DBG_EXIT(fprintf(dbg,"SUCCESS"));
  335.   return SUCCESS;
  336. }
  337.       
  338. /*  Garbage Collection Rational
  339.  *  ======= ========== ========
  340.  *
  341.  *     The current garbage collector is designed to work on the back end only,
  342.  *  there is no need to worry about pointers to the front end as currenmtly 
  343.  *  they cannot be constructed. 
  344.  *    The idea is to half the number of processors and to perform a stop and 
  345.  *  copy operation form one processor set to the idle set and to then resume
  346.  *  processing on the alternative set. To do this the code must all work in 
  347.  *  terms of the Paired Processor macros (see proc_pair.h). 
  348.  *  
  349.  */
  350.  
  351.  
  352. /*----------------------------------------------------------------------------*
  353.  * Function   : gc
  354.  *
  355.  * Parameters : MP_PluralHeap MPPH_objects:    This is a parallel lisp object
  356.  *                        to be (recursively) copied
  357.  *                        to the alternative processor
  358.  *                        set
  359.  *
  360.  * Description:    What the function does should go here. The problem of 
  361.  *        justification
  362.  *
  363.  * Result     : MP_PluralHeap: the new position of the objects
  364.  *---------------------------------------------------------------------------*/
  365.  
  366. #ifdef __STDC__
  367.  
  368. plural natural gc( plural natural offsets )
  369.  
  370. #else
  371.  
  372. plural natural gc( offsets )
  373.  
  374. plural natural offsets;
  375.  
  376. #endif
  377.  
  378. {
  379.   plural natural *plural general_vector;
  380.   plural natural size, align;
  381.   plural natural result_offset;
  382.   plural heap_header headers;
  383.   plural heap_header data;
  384.   plural natural this_heap_space;
  385.   plural int i;
  386.   DBG_CALL("gc");
  387.   DBG_ARGS(DBG_PARG("PP_iproc","%d ",PP_iproc);DBG_PARG("   \noffsets","%d ",offsets));
  388.  
  389.   /*  The active set on entry to the function will be pairs of processors,
  390.    *  that is for each gcing processor which is active, its associated
  391.    *  pair-processor is also active.
  392.    */
  393.  
  394.   PP_on_set() PP_push_to(offsets, offsets);
  395.  
  396.   if ((offsets == NIL) || (offsets == NOT_NIL)) {
  397.  
  398.     result_offset = offsets;                     /*  These special objects   */
  399. DBG_EXIT(DBG_PARG("","%d ",result_offset));
  400.     return result_offset;                        /*  are represented by a
  401.                           *  special offset, so we
  402.                           *  merely copy this offset
  403.                           */
  404.   }
  405.  
  406.   PP_on_set() {
  407.  
  408.     headers = heap_memory[offsets];              /*  get headers             */
  409.     PP_push_to(headers, headers);                /*  duplicate in paired PE 
  410.                           *  this will mean the PES
  411.                           *  get activated in pairs
  412.                           */
  413.   }
  414.  
  415.   if (HH_gced_p(headers)) {            /*  already gced the offset of the 
  416.                     *  object on the `off' PE is held
  417.                     *  on the `on' PE in the header,
  418.                     *  copy this offset
  419.                     */
  420.  
  421.     PP_on_set() PP_push_to(result_offset, HH_gcto(headers));
  422. DEBUG(DBG_PARG("Extracted forward address","%d ",headers));
  423. DBG_EXIT(DBG_PARG("","%d ",result_offset));
  424.     return result_offset;
  425.   }
  426.  
  427. /*   PP_off_set() {
  428.  * 
  429.  *     result_offset = heap_space;             
  430.  *     PP_push_to(result_offset, result_offset);
  431.  *     heap_memory[heap_space++] = headers;     
  432.  *   }
  433.  *   PP_on_set() HH_gc_moved(heap_memory[offsets],result_offset);
  434.  */                                  
  435.                                 
  436.   /* Deal with the header: Increament heap_space, it now is the position where
  437.    * the data starts and the header goes in the previous slot. munge the heap 
  438.    * space to allow for alignment if required. result_offset, is where the
  439.    * header is (i.e. heap_space - 1) and we leave the forwarding address
  440.    */
  441.  
  442.   PP_off_set() ++heap_space;
  443.  
  444.   switch (HH_info(headers)) {
  445.  
  446.   case MP_SYMBOL:
  447.   case MP_FLOAT:
  448.   case INTEGER:   
  449.  
  450.     align = type_info_table[HH_info(headers)][TYPE_ALIGN];
  451.     PP_off_set() heap_space = heap_space +(((heap_space * sizeof(natural)) % 
  452.                         align) / sizeof(natural));
  453.   default:
  454.     
  455.     PP_off_set() heap_memory[(result_offset = heap_space-1)] = headers;
  456.     
  457.     PP_on_set() {
  458.  
  459.       PP_pull_to(result_offset,result_offset);
  460.       HH_gc_moved(heap_memory[offsets],result_offset);
  461.     }
  462.   }
  463.  
  464.   switch (HH_info(headers)) {
  465.     
  466.   case MP_SYMBOL:
  467.   case MP_FLOAT :               /* Just copy the 4-byte bit pattern across */
  468.   case INTEGER :
  469.  
  470.     size = MP_LENGTH(type_info_table[HH_info(headers)][TYPE_SIZE]);
  471.     
  472.     for (i=1; i<=size; i++) {   /*  We have to swap between active sets since
  473.                  *  an operation has to be preformed on both
  474.                  *  PEs as well as the Xnet assignment 
  475.                  */
  476.       
  477.       PP_on_set() data = heap_memory[offsets + i];
  478.       PP_off_set() PP_pull_to(heap_memory[heap_space++],data);
  479.     }
  480.     break;
  481.     
  482.   case MP_VECTOR :              /*  These contain objects so we have to */
  483.   case MP_CONS :                /*  call gc again to copy them
  484.                  *  across. The result is the new address
  485.                  *  in the `off' set of PEs.
  486.                  */
  487.     
  488.     size = MP_LENGTH(HH_space(headers));     /* reserve space for object */
  489.     PP_off_set() heap_space=heap_space+size;  
  490.     general_vector = (plural natural *plural) (heap_memory + offsets + 1);
  491.     
  492.     for (i = 0; i<size; i++) { /*  Note: Pairs of active processors still */
  493.       
  494.       data = (plural heap_header) gc(general_vector[i]);
  495.       PP_off_set() heap_memory[result_offset+i+1]=data;
  496.     }
  497.     break;
  498.   }
  499.  
  500. DBG_EXIT(DBG_PARG("","%d ",result_offset));
  501.   return result_offset;
  502. }
  503.  
  504. /*----------------------------------------------------------------------------*
  505.  * Function   : mp_gc
  506.  *
  507.  * Parameters : none
  508.  *
  509.  * Description: Garbage collects the system, this involves following all the
  510.  *              heap roots in the plural space and copying them to the
  511.  *              `off' processor set. The active memory will be contiguous
  512.  *              and garbage will have been lost. The `off' set becomes the
  513.  *              `on' set.
  514.  *
  515.  * Result     : void
  516.  *---------------------------------------------------------------------------*/
  517.  
  518. #ifdef __STDC__
  519.  
  520. visible void mp_gc( void )
  521.  
  522. #else
  523.  
  524. visible void mp_gc( )
  525.  
  526. #endif  
  527.  
  528. {
  529.   int i;
  530.   plural int retrieved;
  531.   plural natural new_offsets;
  532.   plural natural gc_root;
  533.   int old_debug_status=debug_status;
  534.   DBG_CALL("mp_gc");
  535.   DBG_ARGS(fprintf(dbg,"void"));
  536.  
  537.   PP_on_set() retrieved = heap_space;
  538.  
  539.   DBG_OFF();
  540.   all {
  541.  
  542.     PP_off_set() heap_space = NOT_NIL + MP_LENGTH(sizeof(heap_header) + 
  543.                         type_info_table[MP_SYMBOL][TYPE_SIZE]);
  544.  
  545.     for (i = TOP; i>plural_space; i--) {
  546.  
  547.     /*  First copy the data across, if this is not actually a pointer we need
  548.      *  to do this any way. It also means we can activate the processors in
  549.      *  pairs when we examine the contents of the slot. This is necessary for
  550.      *  the calls to gc.
  551.      */
  552.  
  553.       PP_on_set() PP_push_to(plural_memory[i],plural_memory[i]);
  554.  
  555.       if (!(plural_memory[i] & FREE_FLAG)) {  /*  Not free memory so gc it. The
  556.                            *  value of gc for the `off'
  557.                            *  set is where the `on' objects
  558.                            *  were copied to. The `on' 
  559.                            *  value is not important.
  560.                            */
  561.       
  562.     plural_memory[i] = gc( plural_memory[i] );
  563.       }
  564.     }
  565.  
  566.     /*  Because we may have gced in the middle of doing something we may have
  567.      *  handles on heap stuff which are not reachable from the plural space.
  568.      *  We instigate a gc for each of the varibales on the gc protect stack
  569.      */
  570.  
  571.     fprintf(stderr,"mp_gc debug: %d gc protect roots\n",next_gc_root);
  572.  
  573.     for (i=0;i<next_gc_root;i++) {
  574.  
  575.       gc_root = *gc_roots[i];
  576.       PP_on_set() PP_push_to(gc_root,gc_root);
  577.       if (!(gc_root & FREE_FLAG)) gc_root = gc( gc_root );
  578.       PP_on_set() PP_pull_to(gc_root,gc_root);
  579.       *gc_roots[i] = gc_root;
  580.     }
  581.  
  582.     /*  Now we have to copy the gumpf back, the starting active set is 
  583.      *  the even processors so we are copying from the offset, leftwards
  584.      */
  585.  
  586.     PP_off_set() {
  587.  
  588.       pp_xsend(0,-1,(plural char *plural) heap_memory, 
  589.            (plural char *plural) heap_memory, MEMORY_SIZE_IN_BYTES);
  590.       PP_push_to(heap_space,heap_space);
  591.     }
  592.   }
  593.   debug_status=old_debug_status;
  594.  
  595.  
  596.   /* Some More Debugging Info */
  597.  
  598.   PP_on_set() {
  599.  
  600.     retrieved = retrieved - heap_space;
  601.     fprintf(stderr,"Top-Level=%s, some stats:\n",gc_message);
  602.     DBG_PVAR(stderr,"Retrieved","%04d ",retrieved);
  603.     DBG_PVAR(stderr,"\nHeap Top ","%04d ",heap_space);
  604.     fprintf(stderr,"\n");
  605.   }
  606.   DBG_OFF();
  607.   DBG_EXIT(fprintf(dbg,"void"));
  608. }
  609.  
  610.       
  611.  
  612.  
  613.